(FILECREATED "14-APR-74 01:26:47" TOPLEVEL

     changes to:  RINGSKELETONS, NOFVRINGS

     previous date: "13-APR-74 03:09:16")


(LISPXPRINT (QUOTE TOPLEVELVARS) T)
(RPAQQ TOPLEVELVARS ((FNS MOLECULES SUPERATOMS RINGS RINGSKELETONS NOFVRINGS
DAISIES NOLOOPEDRINGS) (FNS ATTACHFVS ATTACHBIVALENTS ATTACHBIVS&LOOPS 
STRUCTURESWITHATOMS)))
(DEFINEQ

(MOLECULES
(LAMBDA (CL U) (COND ((ZEROP U) (GENMOL CL)) (T (for SAP in (SUPERATOMPARTITIONS
CL U) join (for S in (SUPERATOMS (fetch SUPERATOMPARTS of SAP)) bind NEWCL
join (COND ((EQ (CLCOUNT (SETQ NEWCL (APPEND (CLCREATE S) (fetch REMAININGATOMS
of SAP)))) 1) (LIST (CAAR NEWCL))) (T (GENMOL NEWCL)))))))))

(SUPERATOMS
(LAMBDA (U.CL.CL) (GROUPRADS (for UCLN in U.CL.CL collect (CONS (RINGS (CAAR
UCLN) (CDAR UCLN)) (CDR UCLN))))))

(RINGS
(LAMBDA (U CL) (COND ((EQ 2 (CLCOUNT CL)) (SETQ CL (CLEXPAND CL)) (LIST (
STRUCWITH2NODES (ADD1 U) (CAR CL) (CADR CL)))) (T (PROG (FV) (SETQ FV (COMPUTEFV
U CL)) (SETQ CL (CLBYVALENCE CL)) (RETURN (for SKELETON in (RINGSKELETONS
FV (MAPCAR CL (FUNCTION CLCOUNT))) join (STRUCTURESWITHATOMS CL SKELETON))))))))

(RINGSKELETONS
(LAMBDA (FV VL) (COND ((ZEROP FV) (NOFVRINGS VL)) (T (for FVSECTION in (GROUPBY
(FUNCTION (LAMBDA (X) (fetch NEWVL of X))) (FVPARTITIONS FV VL)) bind STRUCLIST
join (SETQ STRUCLIST (NOFVRINGS (CAR FVSECTION))) (for FVPART in (CDR FVSECTION)
join (for STRUC in STRUCLIST join (ATTACHFVS (fetch FVR of FVPART) STRUC))))))))

(NOFVRINGS
(LAMBDA (VL) (SETQ VL (TRIMZEROS VL)) (COND ((NULL (CDR VL)) (SINGLERINGS
(CAR VL))) ((EVERY (CDR VL) (FUNCTION (LAMBDA (X Y) (OR (ZEROP X) (AND (EQ
X 1) (NULL (CDR Y))))))) (DAISIES VL)) (T (bind ((MAXP← (MAXLOOPS VL))) for
P from (MINLOOPS VL) to MAXP join (COND ((ZEROP P) (NOLOOPEDRINGS VL)) (T
(for LPSECTION in (LOOPPARTITIONS P VL) bind STRUCLIST when (SETQ STRUCLIST
(NOFVRINGS (fetch LOOPVL of (CAR LPSECTION)))) join (for LOOPPART in LPSECTION
join (for STRUC in STRUCLIST join (ATTACHBIVS&LOOPS (fetch EDGELABELS of 
LOOPPART) (fetch LOOPLABELS of LOOPPART) STRUC)))))))))))

(DAISIES
(LAMBDA (VL) (PROG (BIGVALENCE) (SETQ VL (TRIMZEROS VL)) (SETQ BIGVALENCE
(ADD1 (LENGTH VL))) (OR (EVENP BIGVALENCE) (HELP "BAD VL TO DAISIES" VL))
(for P in (NUMPARTITIONS (CAR VL) (IQUOTIENT BIGVALENCE 2) 1 NIL) join (DAISY
(CLCREATE P))))))

(NOLOOPEDRINGS
(LAMBDA (VL) (COND ((ZEROP (CAR VL)) (CATALOG (CDR VL))) (T (PROG (BP) (SETQ
BP (BIVALENTPARTITIONS VL)) (RETURN (for S in (CATALOG (CDR VL)) join (for
P in BP join (ATTACHBIVALENTS (CLCREATE P) S)))))))))
)
(DEFINEQ

(ATTACHFVS
(LAMBDA (FVP STRUC) (COND ((type? STRUCFORM STRUC) (LIST (create FORM FN ←
(QUOTE ATTACHFVS) ARGS ← (LIST FVP STRUC)))) (T (for L in (LLABELNODES STRUC
FVP) collect (PUTFVS (COPYSTRUC (fetch LSTRUC of L)) (fetch LABELED of L)))))))

(ATTACHBIVALENTS
(LAMBDA (PART STRUC) (COND ((type? STRUCFORM STRUC) (LIST (create FORM FN
← (QUOTE ATTACHBIVALENTS) ARGS ← (LIST PART STRUC)))) (T (for L in (LABELEDGES
STRUC (CDRLIST PART)) collect (PUTBIVS (COPYSTRUC (fetch LSTRUC of L)) (CARLIST
PART) (fetch LABELED of L)))))))

(ATTACHBIVS&LOOPS
(LAMBDA (EL LL STRUC) (COND ((type? STRUCFORM STRUC) (LIST (create FORM FN
← (QUOTE ATTACHBIVS&LOOPS) ARGS ← (LIST EL LL STRUC)))) ((NULL EL) (for L2
in (LLABELNODES STRUC (LCDRLIST LL)) rcollect (PUTLOOPS (COPYSTRUC (fetch
LSTRUC of L2)) (LCARLIST LL) (fetch LABELED of L2)))) (T (for L1 in (LABELEDGES
STRUC (CDRLIST EL)) join (for L2 in (LLABELNODES (fetch LSTRUC of L1) (LCDRLIST
LL)) rcollect (PUTLOOPS (PUTBIVS (COPYSTRUC (fetch LSTRUC of L2)) (CARLIST
EL) (fetch LABELED of L1)) (LCARLIST LL) (fetch LABELED of L2))))))))

(STRUCTURESWITHATOMS
(LAMBDA (CLL STRUC) (COND ((type? STRUCFORM STRUC) (LIST (create FORM FN ←
(QUOTE STRUCTURESWITHATOMS) ARGS ← (LIST CLL STRUC)))) ((EVERY CLL (FUNCTION
(LAMBDA (X) (NULL (CDR X))))) (SETQ STRUC (COPYSTRUC STRUC)) (for X in (fetch
CTABLE of STRUC) do (replace ATOMTYPE of X with (CAAAR (NTH CLL (SUB1 (
NODEVALENCE X)))))) (LIST STRUC)) (T (for L in (LLABELNODES STRUC (LCDRLIST
CLL)) collect (INSERTMARKERS (COPYSTRUC (fetch LSTRUC of L)) CLL (fetch LABELED
of L)))))))
)
STOP